home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 021-030 / amok29 / disktohard / disktohard.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  120 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    DiskToHard.mod
  4.     :Contents.   copies an entire disk to a file on a harddisk
  5.     :Author.     Nicolas Benezan [bne]
  6.     :Author.     Norbert Klapczynski
  7.     :Copyright.  Public Domain
  8.     :Language.   Modula-2
  9.     :Translator. M2Amiga AMSoft V3.2
  10.     :Imports.    ErrorReq1.3         (on Amok#25:M2Make1.9/Modules)
  11.     :Imports.    ExDos1.1            (on Amok#25:M2Make1.9/Modules)
  12.     :Imports.    MemSystem1.4        (on Amok#25:M2Make1.9/Modules)
  13.     :Imports.    TrackDiskSupport2.1 (on Amok#19:TrackDiskSupport_2.1)
  14.     :Imports.    StringOps           (on this disk :Strings)
  15.     :History.    V1.0 Norbert, [bne] 15.Aug.1989
  16.     :History.    V1.1 [bne] 1.Dez.1989 (cosmetics)
  17.  
  18. **********************************************************************)
  19.  
  20. MODULE DiskToHard;
  21.  
  22. FROM Arts             IMPORT TermProcedure;
  23. FROM Dos              IMPORT Close, Delay, FileHandlePtr, newFile, Open,
  24.                              Write;
  25. FROM ErrorReq         IMPORT Assert;
  26. FROM ExDos            IMPORT Examine, FileInfoBlock, FileLockPtr, Lock,
  27.                              sharedLock, UnLock;
  28. FROM Icon             IMPORT FreeDiskObject, GetDiskObject, PutDiskObject;
  29. FROM MemSystem        IMPORT Deallocate, NoCareAllocMem;
  30. FROM StringOps        IMPORT Assign, Concat;
  31. FROM SYSTEM           IMPORT ADDRESS, ADR;
  32. FROM TrackDiskSupport IMPORT ChangeState, CloseDiskDevice, DeviceInfo,
  33.                              DiskUnit, GetDeviceInfo, GetDiskChange,
  34.                              InhibitDrive, OpenDiskDevice, ReadBlock;
  35. FROM Workbench        IMPORT DiskObjectPtr, noIconPosition, WBObjectType;
  36.  
  37. VAR
  38.   Unit: DiskUnit;
  39.   File: FileHandlePtr;
  40.   Info: DeviceInfo;
  41.   Block: INTEGER;
  42.   BlocksPerTrack: INTEGER;
  43.   Change: LONGINT;
  44.   Buffer: ADDRESS;
  45.   DiskName: ARRAY [0..30] OF CHAR;
  46.   Busy: BOOLEAN;
  47.  
  48. PROCEDURE Cleanup;
  49.   BEGIN
  50.     IF File#NIL THEN
  51.       Close(File);
  52.     END;
  53.     IF Busy AND InhibitDrive(Unit, FALSE) THEN END;
  54.   END Cleanup;
  55.  
  56. PROCEDURE GetDiskName (VAR Name: ARRAY OF CHAR);
  57.   VAR
  58.     DiskLock: FileLockPtr;
  59.     DiskInfo: FileInfoBlock;
  60.   BEGIN
  61.     DiskLock:= Lock("DF0:", sharedLock);
  62.     Assert ((DiskLock # NIL) AND Examine (DiskLock, DiskInfo),
  63.             ADR ("Disk unlesbar"));
  64.     Assign (DiskInfo.fileName, Name);
  65.     UnLock (DiskLock);
  66.   END GetDiskName;
  67.  
  68. PROCEDURE CopyIcon (Name: ARRAY OF CHAR);
  69.   VAR
  70.     Icon: DiskObjectPtr;
  71.   BEGIN
  72.     Icon:= GetDiskObject (ADR ("DF0:Disk"));
  73.     IF Icon= NIL THEN
  74.       Icon:= GetDiskObject (ADR ("Disk")); (* default icon *)
  75.     END;
  76.     Assert (Icon # NIL, ADR ("Icon nicht gefunden"));
  77.     WITH Icon^ DO
  78.       defaultTool:= ADR ("/HardToDisk");
  79.       type:= project;
  80.       currentX:= noIconPosition;
  81.       currentY:= noIconPosition;
  82.     END;
  83.     IF PutDiskObject (ADR (Name), Icon) = 0 THEN END;
  84.     FreeDiskObject (Icon);
  85.   END CopyIcon;
  86.  
  87. BEGIN
  88.   File:= NIL;
  89.   Busy:= FALSE;
  90.   IF (OpenDiskDevice ("DF0", Unit) = 0) AND ChangeState (Unit) THEN
  91.     GetDiskName (DiskName);
  92.     TermProcedure (Cleanup);
  93.     Assert (InhibitDrive (Unit, TRUE), ADR ("Drive nicht verfügbar"));
  94.     Busy:= TRUE;
  95.     Change:= GetDiskChange (Unit);
  96.     GetDeviceInfo (Unit, Info);
  97.     WITH Info DO
  98.       NoCareAllocMem (Buffer, trackLen, TRUE);
  99.       Concat ("Disks/", DiskName, DiskName);
  100.       File:= Open (ADR (DiskName), newFile);
  101.       IF File # NIL THEN
  102.         BlocksPerTrack:= trackLen DIV blockLen;
  103.         Block:= 0;
  104.         REPEAT
  105.           Assert (ReadBlock (Unit, Block, BlocksPerTrack, Buffer, Change)
  106.                   = 0, ADR ("Lesefehler"));
  107.           Assert (Write (File, Buffer, trackLen) = trackLen,
  108.                   ADR("Schreibfehler"));
  109.           INC (Block, BlocksPerTrack);
  110.         UNTIL Block >= numBlocks;
  111.         Busy:= NOT InhibitDrive (Unit, FALSE);
  112.         Delay (100);        (* let file system time to validate the disk *)
  113.         CopyIcon (DiskName);(* without delay, this causes a requester:   *)
  114.                             (* no disk present in drive 0                *)
  115.       END;
  116.     END;
  117.   END;
  118. END DiskToHard.
  119.  
  120.